home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt85jul.lbr / TRAVPC1.BQS / TRAVPC1.BAS
BASIC Source File  |  1985-09-15  |  8KB  |  146 lines
  1. @set(page=0)
  2. @style[leftmargin=11 char,rightmargin=11 char]
  3. @style[headerspacing 3 lines,footerspacing 3 lines]
  4. @pageheading[left="Travesty Revisited"
  5.     right="Listing, page @value(page) of 3"]
  6. @pagefooting[center=" "]
  7. @newpage
  8. @begin[format]    1:  '                   ************************
  9.     2:  '                   ***   TRAVESTY.BAS   ***
  10.     3:  '                   ************************
  11.     4:  
  12.     5:  ' Based on the article and Pascal program "Travesty" by Hugh Kenner
  13.     6:  '   and Joseph O'Rourke, in BYTE for November, 1984.
  14.     7:  
  15.     8:  '       Written by M. L. Lesser, November 26, 1984
  16.     9:  '       Compiled with IBM PC BASIC Compiler, v 1.00, switches /N/E/O
  17.    10:  '               (patches to May, 1984, have been installed)
  18.    11:  
  19.    12:  ' TRAVESTY scans a standard ASCII text file and generates an n-order
  20.    13:  '  simulation of its letter combinations. For order n, the relation of
  21.    14:  '  output to input is: "Any pattern n characters long in the output has
  22.    15:  '  occurred somewhere in the input, and at about the same frequency."
  23.    16:  ' If the verse flag is set, line end symbols will be replaced by "|",
  24.    17:  '   which will generate line ends when they occur in the output text.
  25.    18:  '   Otherwise, output lines will average 50 characters in length.
  26.    19:  ' The output will be displayed during operation, and will be filed in
  27.    20:  '   the standard ASCII file TRAVESTY.DOC.
  28.    21:  
  29.    22:          DEFINT F,I-N            'FLAG.B, FLAG.E, FLAG.V, I, K, L,
  30.    23:                                  'LETTER(), MAX.IN, MAX.OUT, MAX.PAT,
  31.    24:                                  'N.OUT, N.PAT
  32.    25:          DEFSTR O-Z              'PASS, PATTERN, SOURCE, STRING,
  33.    26:                                  'OUT.CHAR
  34.    27:          DIM LETTER(124)
  35.    28:          ON ERROR GOTO 5000
  36.    29:  
  37.    30:  ' Default values:
  38.    31:          LET MAX.IN = 30000      'Maximum input string length
  39.    32:          LET MAX.PAT = 9         'Maximum scan-order length
  40.    33:  
  41.    34:  ' User input data:
  42.    35:          RANDOMIZE                               'Get randomizing seed
  43.    36:          INPUT "Number of characters to be output"; MAX.OUT
  44.    37:  0100    PRINT "Scan order ( 2 - " MAX.PAT ")";     'Simulated repeat
  45.    38:             INPUT N.PAT
  46.    39:          IF N.PAT < 2 OR N.PAT > 9 THEN GOTO 100    'until
  47.    40:          LET N.PAT = N.PAT -1                    'Convenience correction
  48.    41:  0200    INPUT "Name of input file"; SOURCE      'Error RESUME point
  49.    42:          OPEN SOURCE FOR INPUT AS #1             'Trap if no file
  50.    43:          INPUT "Prose or verse"; PASS
  51.    44:          IF LEFT$(PASS,1) = "V" OR LEFT$(PASS,1) = "v"_
  52.    45:             THEN LET FLAG.V = -1                 'Set verse flag
  53.    46:  ' Scan input text, deleting unwanted symbols:
  54.    47:  ' (NOTE: If in verse mode, <SP>'s following line-end will be deleted)
  55.    48:          PRINT
  56.    49:          WHILE NOT EOF(1)                        'Read input file one
  57.    50:             LET PASS = INPUT$(1,#1)              ' character at a time
  58.    51:             IF PASS <> CHR$(13)_                 'Bug trap while
  59.    52:                THEN PRINT PASS;                  '  displaying input
  60.    53:             IF PASS = CHR$(13)_                  'Change any <CR>
  61.    54:                THEN LET PASS = ""                ' to <NUL>
  62.    55:             IF PASS = CHR$(10)_                  'Change any <LF>
  63.    56:                THEN LET PASS = " ":_             ' to <SP>
  64.    57:                     IF FLAG.V_                   ' or (if verse)
  65.    58:                        THEN LET PASS = "|"       ' to special line-end
  66.    59:             IF PASS = CHR$(9)_                   'Change any <HT>
  67.    60:                THEN LET PASS = " "               ' to <SP>
  68.    61:             IF PASS <> " " AND PASS <> ""_       'Unless <SP> or <NUL>
  69.    62:                THEN LET FLAG.B = 0               '  reset blank flag
  70.    63:             IF NOT FLAG.B_                       'If "blank" flag clear
  71.    64:                THEN LET STRING = STRING + PASS   '   add to string
  72.    65:             IF (FLAG.V AND PASS = "|")_          'Set blank flag to
  73.    66:             OR (PASS = " ")_                     ' delete following
  74.    67:                THEN LET FLAG.B = -1              ' <SP> characters
  75.    68:             IF LEN(STRING) >= MAX.IN_            'If full string:
  76.    69:                THEN GOTO 300                     ' break out of loop   
  77.    70:          WEND                                    'End of input loop
  78.    71:  0300    LET STRING = STRING + LEFT$(STRING,N.PAT)    'End around
  79.    72:  ' Report string space usage and force garbage collection:
  80.    73:          PRINT: PRINT
  81.    74:          PRINT "Input string contains" LEN(STRING) "bytes"
  82.    75:          PRINT "There are" FRE("") "bytes remaining in string space"
  83.    76:          CLOSE #1
  84.    77:          PRINT: PRINT
  85.    78:  ' Open output file:
  86.    79:          OPEN "TRAVESTY.DOC" FOR OUTPUT AS #2
  87.    80:  ' Initial pattern:
  88.    81:          LET PATTERN = LEFT$(STRING,N.PAT)
  89.    82:          PRINT PATTERN;
  90.    83:          PRINT #2, PATTERN;
  91.    84:          LET N.OUT = N.PAT
  92.    85:  0400                            'Start of major "repeat until" loop
  93.    86:  ' Clear letter array (this compiler doesn't have ERASE):
  94.    87:          FOR K = 0 TO 124
  95.    88:             LET LETTER(K) = 0
  96.    89:          NEXT K
  97.    90:  ' Match current pattern:
  98.    91:          LET I = INSTR(STRING,PATTERN)
  99.    92:          WHILE I > 0 AND I <= LEN(STRING) - N.PAT   'Don't run off end
  100.    93:             LET PASS = MID$(STRING,I+N.PAT,1)    'Next character
  101.    94:             LET LETTER(0) = LETTER(0) + 1        'Update total count
  102.    95:             LET K = ASC(PASS)
  103.    96:             LET LETTER(K) = LETTER(K) + 1        'Update character count
  104.    97:             LET I = INSTR(I+1,STRING,PATTERN)    'For next match
  105.    98:          WEND                                    'And around again
  106.    99:  '  Choose next output letter based on use frequency:
  107.   100:          LET L = INT(1 + LETTER(0) * RND)        'Random choice index
  108.   101:          FOR K = 32 TO 124                       'Scan the letter array
  109.   102:             LET L = L - LETTER(K)
  110.   103:             IF L <= 0_                           'This is it
  111.   104:                THEN LET OUT.CHAR = CHR$(K):_
  112.   105:                     GOTO 500                     'Break out of loop
  113.   106:          NEXT K
  114.   107:  0500 'Housekeeping for output character:
  115.   108:          LET N.OUT = N.OUT + 1                   'Increment count
  116.   109:          IF N.OUT MOD 50 = 0_                    'If average line length
  117.   110:             THEN LET FLAG.E = -1                 ' set "line-end" flag
  118.   111:  ' Establish next pattern:
  119.   112:          LET PATTERN = MID$(PATTERN,2) + OUT.CHAR
  120.   113:  ' Display and store character found:
  121.   114:          IF NOT (FLAG.V AND OUT.CHAR = "|")_
  122.   115:             THEN PRINT OUT.CHAR;:_
  123.   116:                  PRINT #2, OUT.CHAR;
  124.   117:  ' Check for line break:
  125.   118:          IF (FLAG.V AND OUT.CHAR = "|")_         'Verse line end
  126.   119:          OR (FLAG.E AND OUT.CHAR = " ")_         'Force line end
  127.   120:             THEN PRINT:_                         ' Display <EOL>
  128.   121:                  PRINT #2,:_                     ' File <EOL>    
  129.   122:                  LET FLAG.E = 0:_                'Reset forced-end flag
  130.   123:                  IF FLAG.V AND OUT.CHAR = " "_   'Forced verse break
  131.   124:                     THEN PRINT SPACE$(5);:_      ' indents next line
  132.   125:                          PRINT #2, SPACE$(5);
  133.   126:          IF INKEY$ = CHR$(3) THEN END            'Emergency exit
  134.   127:  ' Check for end of output:
  135.   128:          IF N.OUT < MAX.OUT OR OUT.CHAR <> " "_
  136.   129:             THEN GOTO 400                        'End of major loop
  137.   130:  END
  138.   131:  
  139.   132:  5000 'Error trap (on "File not found" or "Bad file name"):
  140.   133:          IF ERR = 53 OR ERR = 64_
  141.   134:             THEN PRINT CHR$(34) SOURCE CHR$(34) " does not exist. ";:_
  142.   135:                  PRINT "Try again":_
  143.   136:                  RESUME 200
  144.   137:          ON ERROR GOTO 0
  145.   138:  ' End of source code
  146. @end[format]